{$X-}   {Turn off stack expansion. This is a Lisa concept, not needed on Mac}
{$U-}   {Turn off the Lisa Libraries. This is required by the WorkShop}
{$R-}   {Turn off range checking}

Program LaserPrinting;

(*
 --   Jeffery J. Bradford,  Macintosh Technical Support, Jan 1985
 --
 -- This is a printing example which demonstrates how to print using
 -- the Printing Manager. To use the calls of the Printing Manager
 -- link with obj/PrLink.obj.
 --
 -- This program was written to test out printing cases for the LaserWriter.
 -- If you want to use it to test your own stuff, add the procedure and
 -- call it from the menu list. (see how the program works - its simple).
 -- To print just put your procedure into the Case statement in the Print loop.
 --
 -- The printer dialogs are in a separate menu so you can set up the
 -- format any way you want and then choose Printing Operation from
 -- another menu. Also, be sure to select the desired font, style, and
 -- text size before selecting the print menu item.
 --
 -- If you follow the steps below, your code should print on the Imagewriter
 -- as well as the LaserWriter without any problem.
 --
 --         0. Link with obj/prLink.obj.
 --         0. include {$U Obj/MacPrint  } MacPrint;  in the USES statment.
 --
 --         1. PrOpen       to open the Printing Mgr resource file.
 --         2. PrintDefault to set the initial default settings
 --         2a PrValidate   to set the initial default settings also
 --
 --    now you are ready to print:
 --         3. PrOpenDoc    to open the printing grafport.
 --         4. PrOpenPage   to setup a new page up for printing.
 --         5. Draw into printer port whatever you want printed.
 --         6. PrClosePage  to finish the current page print
 --         7. PrCloseDoc   to close and dealocate the printing grafport.
 --
 --    now you are finished printing
 --         8. PrClose      to close the Printing Mgr resource file
 --
 --
 *)

USES
    {$U Obj/Memtypes  } MemTypes,
    {$U Obj/QuickDraw } QuickDraw,
    {$U Obj/OSIntf    } OSIntf,
    {$U Obj/ToolIntf  } ToolIntf,
    {$U Obj/PackIntf  } PackIntf,
    {$U Obj/MacPrint  } MacPrint;

CONST
    Bit7      = 7;
{menu stuff}
    AppleMenu = 256;
    PrintMenu = 257;
    FontMenu  = 258;
    StyleMenu = 259;
    PrDlogMenu= 260;
    PrDrvrMenu= 261;
    PicScrMenu= 262;

{print tests for Pr Mgr only}
    PrDrawPicture = 1;
    PrMakeQDCalls = 2;
    PrFramePage   = 3;
    PrFrameText   = 4;
    PrUseTextBox  = 5;
    PrBitMap      = 6;
    PrChkSetOrig  = 7;
    PrChkPicComm  = 8;
    PrRotateTex   = 9;
    PrFineGrid    = 10;
    PrSmothPloy   = 11;

{devices}
    theScreen  = 0;
    theImageW  = 1;
    theDaisyW  = 2;
    theLaserW  = 3;

{picture comment constants}
    TextBegin = 150;
    TextEnd   = 151;
    TextCenter= 154;

    PolyBegin = 160;
    PolyEnd   = 161;
    PolyIgnore= 163;
    PolyVerb  = 164;

{window & dialog resource IDs}
    WindResID = 257;



TYPE
    IconData = Array[0..95] of integer;

    GetStuff = Packed Record
       Case Integer of
        0: (a0: Integer);
        1: (b1,b0: SignedByte);
        2: (f15,f14,f13,f12,f11,f10,f9,f8,f7,f6,f5,f4,f3,f2,f1,f0: Boolean)
       End;

    LMwordPtr = ^Integer;          {pointer to low memory address}


VAR
{bit map stuff}
    icons: Array[0..5] of IconData; {store 6 icons in here}
    whichIcon:    integer;          {holds icon ID number}
    QDPicture:    PicHandle;        {handle to the QD Picture}

{global program stuff}
    Finished:      Boolean;    {used to terminate the program}
    ClockCursor:   CursHandle; {handle to the waiting watch cursor}

{font stuff}
    CurntFontID:   Integer;   {holds the currently selected text font}
    CurntStyleID:  Style;     {holds the currently selected text style}
    CurntSizeID:   Integer;   {holds the currently selected text size}
    PrevFontChked: Integer;   {holds the previously slected font}

{printer stuff}
    PrRecordHdl:   THPrint;   {handle to the print record}
    PrPortStorage: TPrPort;   {storage for the printer grafport}
    PrintPort:     TPPrPort;  {pointer to the printers grafport}
    DefaltPage:    Rect;      {holds the currently selected printer page size}
    CurPrTest:     Integer;   {holds the value to the current drawing routine}
    PrDlgPtr:      DialogPtr; {pointer to the cancel/pause dialog}
    PrStopDlgRec:DialogRecord;{record for the cance/pause dialog}

{window stuff}
    DragArea,                 {holds the area where window can be dragged in}
    GrowArea,                 {holds the area to which a window's size can change}
    Screen:     Rect;         {holds the screen dimensions}
    aWindow:    WindowPtr;    {pointer to text window}

{-----------------------------------------------------------------------------
                     end of global variable definition
-----------------------------------------------------------------------------}

{The following procedures contain printing code to: Print text, print graphics,}
{print a bitmap, print the screen, and test out weird things developers do}

{-----------------------------------------------------------------------------}

{                     Printing Manager Procedures                             }

PROCEDURE FramePage     (Where: integer);               FORWARD;
PROCEDURE PrintBitMap   (Where: integer);               FORWARD;
PROCEDURE MakeQDCalls   (where:integer);                FORWARD;
PROCEDURE ShowAllQDCalls(Where:integer);                FORWARD;
PROCEDURE BuildQDPicture(where:integer);                FORWARD;
PROCEDURE ShowQDPic     (Where:integer);                FORWARD;
PROCEDURE UseTextBox    (Where: Integer);               FORWARD;
PROCEDURE FrameText     (Where: Integer);               FORWARD;
PROCEDURE PrintLables   (Where: Integer);               FORWARD;
PROCEDURE PrintText     (Where: Integer);               FORWARD;
PROCEDURE PrintRotText  (Where: Integer);               FORWARD;
PROCEDURE PrintFineGrid (Where: Integer);               FORWARD;
PROCEDURE PrintPolygon  (Where: Integer);               FORWARD;


{                     Printer Driver Procedures                             }
PROCEDURE PutPicScrap;                                  FORWARD;
PROCEDURE PrDrBitMap;                                   FORWARD;
PROCEDURE PrDrScr_wEvtCtl;                              FORWARD;
PROCEDURE PrDrScrBitMap;                                FORWARD;
PROCEDURE PrDrStreamText;                               FORWARD;
PROCEDURE PrDrPostScript;                               FORWARD;

{-----------------------------------------------------------------------------}

PROCEDURE SetPrDialog(Printer: Integer);
Var IType: Integer;
    IHdl:  Handle;
    IRect: Rect;
Begin
  PrDlgPtr := GetNewDialog(257, @PrStopDlgRec, Pointer(-1));

{disable the continue item to start with}
  GetDItem(PrDLgPtr, 3, Itype, IHdl, IRect);   {get the item}
  HiliteControl(ControlHandle(IHdl), 255);     {disable it}

{if its the laser disable the pause item}
  If Printer = theLaserW then
  begin
    GetDItem(PrDLgPtr, 2, Itype, IHdl, IRect);   {get the item}
    HiliteControl(ControlHandle(IHdl), 255);     {disable it}
  end;

  DrawDialog(PrDlgPtr);
End;

{-----------------------------------------------------------------------------}

PROCEDURE ChkForCanceOrPause;
Var ProcessIt: Boolean;
    itemHit:   Integer;
    itemHdl:   Handle;
    itemRect:  Rect;
    Event:     EventRecord;
    DlgPtr:    DialogPtr;

Begin
  ProcessIt := GetNextEvent(EveryEvent, Event);
  If IsDialogEvent(Event) then
    If DialogSelect(Event, DlgPtr, ItemHit) then
      Case itemHit of
        1: PrSetError(iPrAbort);
        2: begin end; {pause enable continue disable pause go into repeat loop}
        3: begin end; {continue and enable pause}
      End;
End;

{-----------------------------------------------------------------------------}

PROCEDURE PrintIt(PrintWhat: Integer);
Var
    numCopies:   Integer;      {holds the number of copies the user wants}
    Count:       Integer;      {used to count number of copies}
    TempPort:    GrafPtr;      {holds the current port while printport is used}
    Status:      TPrStatus;    {record for status while spool printing occors}
    dummy:       boolean;      {just a dummy boolean for function assignment}
    thePrinter:  integer;      {ID of the type of printer}

Begin

{get the current port & save it}
    GetPort(TempPort);

{get the type of printer we are printing to}
    thePrinter:= GetStuff(PrRecordHdl^^.PrStl.wDev).b1;

{If current test is picture then create it}
    If CurPrTest = PrDrawPicture then
      BuildQDPicture(thePrinter);

{set our idleproc to handle aborts & pauses; Setup the Dialog also}
    PrRecordHdl^^.prJob.pIdleProc := @ChkForCancelOrPause;
    SetPrDialog(thePrinter);

{open up the printer port, port is set automaticly}
    PrintPort := PrOpenDoc(PrRecordHdl, @PrPortStorage, Nil);

{loop on the number of copies}
    numCopies := PrRecordHdl^^.prJob.iCopies;
    For count := 1 to numCopies do
    begin
       PrOpenPage(PrintPort, Nil);    {Nil= do not scale the drawing}

         Case CurPrTest of
           PrDrawPicture: ShowQDPic     (thePrinter);  {1}
           PrMakeQDCalls: ShowAllQDCalls(thePrinter);  {2}
           PrFramePage:   FramePage     (thePrinter);  {3}
           PrFrameText:   FrameText     (thePrinter);  {4}
           PrUseTextBox:  UseTextBox    (thePrinter);  {5}
           PrBitMap:      PrintBitMap   (thePrinter);  {6}
           PrChkSetOrig:  PrintLables   (thePrinter);  {7}
           PrChkPicComm:  PrintText     (thePrinter);  {8}
           PrRotateTex:   PrintRotText  (thePrinter);  {9}
           PrFineGrid:    PrintFineGrid (thePrinter);  {10}
           PrSmothPloy:   PrintPolygon  (thePrinter);  {11}
         End;

       PrClosePage(PrintPort);
    end;

    PrCloseDoc(PrintPort);   {close PrGrafport}
    SetPort(TempPort);       {Reset the port}

{If spooling was selected, print the file now}
    If (PrRecordHdl^^.PrJob.bJDocLoop = bSpoolLoop) AND (PrError=0)
    then PrPicFile(PrRecordHdl,@PrPortStorage, NIL, NIL, Status);

{get rid of Cancel dialog}
   CloseDialog(PrDlgPtr);
End;

{-----------------------------------------------------------------------------}

{AAA}
{The procedures below print directly to the Driver}


PROCEDURE PrDrBitMap;
{This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
{here only to test the Driver without Pr Manager interference}
Var
    srcBits   : BitMap;
    srcRect   : Rect;

Begin
  PRCLOSE;   {Only calls below needed, if going to directly to PrDriver }

  srcBits.baseAddr:=@icons[0];            {set start address for icon data}
  srcBits.rowBytes:=6;                   {set 6 as # of bytes per row}
  SetRect(srcBits.bounds,0,0,48,32);     {48 X 32 pixels = 6 X 4 bytes}

  PrDRvrOpen;  {not needed if PrOpen has been called}
  PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
  PrCtlCall(iPrBitsCtl, Ord(@srcBits), Ord(@SrcBits.bounds), 1);
  PrDrvrClose;

  PROPEN;  {open up the Printing Manager again}
End;

{-----------------------------------------------------------------------------}

PROCEDURE PrDrScr_wEvtCtl;
{This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
{here only to test the Driver without Pr Manager interference}
Begin
  PRCLOSE;   {Only calls below needed, if going to directly to PrDriver }

  PrDRvrOpen;  {not needed if PrOpen has been called}
  PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
  PrCtlCall(iPrEvtCtl, lPrEvtAll, 0, 0);
  PrDrvrClose;

  PROPEN;  {open up the Printing Manager again}
End;

{-----------------------------------------------------------------------------}

PROCEDURE PrDrScrBitMap;
{This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
{here only to test the Driver without Pr Manager interference}

Begin
  PRCLOSE;   {Only calls below needed, if going to directly to PrDriver }

  PrDRvrOpen;
  PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
  PrCtlCall(iPrBitsCtl, Ord(@ScreenBits), Ord(@ScreenBits.bounds), 1);
  PrDrvrClose;

  PROPEN;  {open up the Printing Manager again}
End;

{-----------------------------------------------------------------------------}

PROCEDURE PrDrStreamText;
{This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
{here only to test the Driver without Pr Manager interference}

Var TxT: Str255;
    len: Integer;
    lParam1: LongInt;

Begin
  PRCLOSE;   {Only calls below needed, if going to directly to PrDriver }

  TextFont(CurntFontID);        {test changing the font}
  TextFace(CurntStyleID);       {test changing the style}
  TextSize(CurntSizeID);        {test changing the size}

  Txt := 'This is text streaming to the LaserWriter';
  Len := Length(Txt);
  lParam1 := $0003FFFF;

  PrDrvrOpen;
  PrCtlCall(iPrDevCtl, lPrReset, 0, 0);

  PrCtlCall(iPrIOCtl, LongInt(@Txt)+1, LongInt(Len), 0);
  PrCtlCall(iPrDevCtl, lParam1, 0,0);

  PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
  PrCtlCall(iPrDevCtl, lParam1, 0,0);

  PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
  PrCtlCall(iPrDevCtl, lParam1, 0,0);

  PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
  PrCtlCall(iPrDevCtl, lParam1, 0,0);

  PrCtlCall(iPrDevCtl, lPrPageEnd, 0, 0);
  PrDrvrClose;

  PROPEN;  {open up the Printing Manager again}
End;

{-----------------------------------------------------------------------------}

PROCEDURE PrDrPostScript;
Begin
End;

{-----------------------------------------------------------------------------}

{BBB}
{the procedures below are used to draw into the Print Managers port}


PROCEDURE InitDisplayArea(Where:integer; Var DisplayArea: Rect);
Begin
  If where = theScreen
  then begin
    SetPort(aWindow);                      {to be sure}
    SetOrigin(0,0);                        {reset from previuos screwy stuff}
    DisplayArea := aWindow^.portRect;
    eraseRect(DisplayArea);
  end
  else DisplayArea := PrRecordHdl^^.prInfoPT.rPage;
End;

{-----------------------------------------------------------------------------}

PROCEDURE FramePage(Where: integer);
{This procedure will frame the windoiw or printable page.}
Var
    DisplayArea: Rect;
    TempPort:    GrafPtr;      {holds the current port while printport is used}
    halflen:     integer;      {used for centering the text}
    Starth:      integer;      {horizontal position of centered text}
    Startv:      integer;      {vertical position of centered text}
    dummy:       boolean;      {just a dummy boolean for function assignment}

Begin
  InitDisplayArea(Where, DisplayArea);

{frame the display area}
  Pensize(3,3);
  FrameRect(DisplayArea);
  pensize(1,1);

{place some centered text in frame, first set the text params}
  TextFont(CurntFontID);                    {set the printers port font}
  TextFace(CurntStyleID);                   {set the printers port style}
  TextSize(CurntSizeID);                    {set the printers port size}

{find the center}
  starth := (DisplayArea.right - DisplayArea.left) div 2;
  Halflen := StringWidth('The printable area is enclosed by this frame') Div 2;
  starth := starth - halflen;
  startv := (DisplayArea.bottom - DisplayArea.top) div 2;

{move to position & draw}
  MoveTo(starth, startv);
  DrawString('The printable area is enclosed by this frame');

End;

{-----------------------------------------------------------------------------}

PROCEDURE PrintBitMap(where: integer);
{This prints a bit map in the rPage area.}
Var
    DisplayArea: Rect;
    srcBits:     BitMap;
    srcRect:     Rect;
    dummy:       boolean;
Begin
  InitDisplayArea(Where, DisplayArea);

{set the bit map up}
  srcBits.baseAddr:=@icons[0];           {set start address for Lisa icon}
  srcBits.rowBytes:=6;                   {set 6 as # of bytes per row}
  SetRect(srcBits.bounds,0,0,48,32);     {48 X 32 pixels = 6 X 4 bytes}
  srcRect:=srcBits.bounds;               {set the source bounding rect}

{show it}
  If where = theScreen then
  CopyBits(srcBits,thePort^.portBits,srcRect,DisplayArea,srcCopy,Nil) {fill scr}
  else
  CopyBits(srcBits,thePort^.portBits,srcRect,DefaltPage,srcCopy,Nil); {full page}

End;

{-----------------------------------------------------------------------------}

PROCEDURE UseTextBox(Where: Integer);
Var
    DisplayArea: Rect;
    Count:       Integer;      {used as a counter}
    TextPage:    Rect;         {destRect for the text}
    TextPtr:     Ptr;          {pointer to the actual text}
    TextLength:  integer;      {length of the text}
    TextJustify: integer;      {justification for the text}
    ViewRect:    Rect;         {rect for viewing text}
    DestRect:    Rect;         {rect for storing text}
    TextHandle:  TEHandle;     {handle to text record}
    TextString:  StringHandle; {store string from resources}

Begin
  InitDisplayArea(Where, DisplayArea);

{first setup the text in the TE record and draw it to the screen}
  ViewRect := DisplayArea;                  {set the display rect}
  DestRect := DisplayArea;
  InSetRect(DestRect,0,4);                  {make the destRect smaller}

  TextHandle := TENew(DestRect,ViewRect);   {get a new record}
  TextHandle^^.txFont := CurntFontID;       {set font for display}
  TextHandle^^.txFace := CurntStyleID;      {set style for displaying the text}
  TextHandle^^.txSize := CurntSizeID;       {set size for displaying the text}

  TextString := GetString(256);             {get the test string from resources}

  HLock(Handle(TextString));                {lock string down}
  HLock(Handle(TextHandle));                {lock text handle down}
  Hlock(Handle(TextHandle^^.hText));        {lock the char handle down}

  For count := 1 to 5 do                    {insert it 5 times}
  begin
    TESetSelect(0,0,TextHandle);            {set the place to insert at begining}
    TEInsert(pointer(ord4(TextString^)+1),  {point to the first character}
                    length(TextString^^),   {get the length of the string}
                             TextHandle);   {pass the string to TextHandle}
  end;

  TECalText(TextHandle);                    {just to be sure everything is OK}

  TextPtr := TextHandle^^.hText^;           {get pointer to the text, its locked}
  TextLength := TextHandle^^.TELength;      {get the length of  the text}
  TextJustify:= 0;                          {set the text justification}

{NOTE: TextBox call eraseRect, so its S L O W on the LaserWriter}
  TextBox(TextPtr, TextLength, DisplayArea, TextJustify);   {draw the text}

  HUnlock(Handle(TextHandle^^.hText));       {unlock the char handle
  HUnLock(Handle(TextHandle));               {unlock the text handle}
  HUnLock(Handle(TextString));               {unlock the string handle}

  TEDispose(TextHandle);
End;

{-----------------------------------------------------------------------------}

PROCEDURE FrameText(Where: Integer);
Var Txt:         Str255;
    len:         integer;
    i:           integer;
    DisplayArea: Rect;
    Frame:       Rect;
    Start:       Point;
    fInfo:       FontInfo;
    ClpRgn:      RgnHandle;
Begin
  InitDisplayArea(Where, DisplayArea);

{use current settings}
  TextFont(CurntFontID);                    {set the font}
  TextFace(CurntStyleID);                   {set the style}
  TextSize(CurntSizeID);                    {set the size}

{always start the text at this point}
  Start.v := 50;
  Start.h := 50;

{get the string dimensions}
  GetFontInfo(fInfo);                               {using current font}
  Frame.right := StringWidth('Have I been - ypgj - framed correctly') + Start.h;
  Frame.left  := Start.h;
  Frame.bottom:= Start.v + fInfo.descent;
  Frame.top   := Start.v - fInfo.ascent;

{now draw the stuff}
  InSetRect(Frame, -1, -1);   {move it out one pixel}
  FrameRect(Frame);

(*   this is for testing the clipping of text
  ClpRgn := NewRgn;            {get a place to store clip region}
  GetClip(ClpRgn);             {get the current clip region}
  ClipRect(Frame);             {clip to it}
*)

  Moveto(Start.h, Start.v);
  DrawString('Have I been - ypgj - framed correctly');

(*  this resets the clip
  SetClip(ClpRgn);             {set the clip back to rPage}
  DisposeRgn(ClpRgn);          {kill the clip region}
*)
End;

{-----------------------------------------------------------------------------}

PROCEDURE PrintLables(Where: Integer);
{NOTE: this procedure tested SetOrigin - it does not   }
{      work within the PrOpenPage and PrClosePage loop.}
Var DisplayArea: Rect;
    Frame:       Rect;
Begin
  InitDisplayArea(Where, DisplayArea);

  SetRect(Frame,0,0,80,50);               {set up the frame}

{first row, three lables across}
  SetOrigin(0,0);    PaintRoundRect(Frame,4,4);
  SetOrigin(-90,0);  PaintRoundRect(Frame,4,4);
  SetOrigin(-180,0); PaintRoundRect(Frame,4,4);

{second row, three lables across}
  SetOrigin(0,-60);    PaintRoundRect(Frame,4,4);
  SetOrigin(-90,-60);  PaintRoundRect(Frame,4,4);
  SetOrigin(-180,-60); PaintRoundRect(Frame,4,4);

{third row, three lables across}
  SetOrigin(0,-120);    PaintRoundRect(Frame,4,4);
  SetOrigin(-90,-120);  PaintRoundRect(Frame,4,4);
  SetOrigin(-180,-120); PaintRoundRect(Frame,4,4);
End;

{-----------------------------------------------------------------------------}

PROCEDURE PrintText(Where: Integer);

{until its defined in interface, define it here}
Type TTxtPicRec = Packed Record
                    tJus: Byte;
                    tFlip:Byte;
                    tRot: Integer;
                    tLine:Byte;
                    tCmmt:Byte;
                  End;

Var DisplayArea: Rect;
    LineHt:      Integer;
    LinePos:     Integer;
    fInfo:       FontInfo;
    PicComRec:   TTxtPicRec;
    PicComPtr:   QDPtr;
    PicComHdl:   QDHandle;

Begin
  InitDisplayArea(Where, DisplayArea);

{setup the pic text comment record pointers, etc}
    PicComPtr :=  @PicComRec;
    PicComHdl :=  @PicComPtr;

{initialize the TTxtPicRec}
  PicComRec.tFlip := 0;    {none}
  PicComRec.tRot  := 0;    {rotation}

{set the current font stuff}
  TextFont(CurntFontID);        {test changing the font}
  TextFace(CurntStyleID);       {test changing the style}
  TextSize(CurntSizeID);        {test changing the size}

{get the line height}
  GetFontInfo(fInfo);           {using current font}
  LineHt := fInfo.descent + fInfo.ascent + fInfo.leading;
  LinePos := LineHT;

{this is before starting any pic comments}
  SetOrigin(0,0);
  LinePos := LineHT;   {move to the first line}

  Moveto(5,LinePos);DrawString('This is before any Pic Comments');

  LinePos := LinePos + LineHT;
  Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');


{----------test the "none" justification}
  PicComRec.tJus := 0;                    {NONE justify}
  PicComment(TextBegin, 6, PicComHdl);    {TEXT BEGIN Comment}

  LinePos := LinePos + 2*LineHT;
  Moveto(5,LinePos);DrawString('This is with NONE justification');

  LinePos := LinePos + LineHT;
  Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');

(*  PicComment(151, 0, NIL);                  {TEXT END Comment}  *)


{----------test the "left" justification}
  PicComRec.tJus := 1;                    {LEFT justify}
  PicComment(TextBegin, 6, PicComHdl);  {TEXT BEGIN Comment}

  LinePos := LinePos + 2*LineHT;
  Moveto(5,LinePos);DrawString('This is with LEFT justification');

  LinePos := LinePos + LineHT;
  Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');

(*  PicComment(151, 0, NIL);                  {TEXT END Comment}  *)


{----------test the "center" justification}
  PicComRec.tJus := 2;                    {CENTER justify}
  PicComment(TextBegin, 6, PicComHdl);

  LinePos := LinePos + 2*LineHT;
  Moveto(5,LinePos);DrawString('This is with CENTER justification');

  LinePos := LinePos + LineHT;
  Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');

(*  PicComment(151, 0, NIL);                  {TEXT END Comment}  *)


{----------test the "right" justification}
  PicComRec.tJus := 3;                    {RIGHT justify}
  PicComment(TextBegin, 6, PicComHdl);    {TEXT BEGIN Comment}

  LinePos := LinePos + 2*LineHT;
  Moveto(5,LinePos);DrawString('This is with RIGHT justification');

  LinePos := LinePos + LineHT;
  Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');

(*  PicComment(151, 0, NIL);                  {TEXT END Comment}  *)

{----------test the "full" justification}
  PicComRec.tJus := 4;                    {FULL justify}
  PicComment(TextBegin, 6, PicComHdl);    {TEXT BEGIN Comment}

  LinePos := LinePos + 2*LineHT;
  Moveto(5,LinePos);DrawString('This is with FULL justification');

  LinePos := LinePos + LineHT;
  Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');

  PicComment(TextEnd, 0, NIL);             {TEXT END Comment}

End;

{-----------------------------------------------------------------------------}

PROCEDURE PrintRotText(Where: Integer);

{until its defined in interface, define it here}
Type TTxtPicRec = Packed Record
                    tJus: Byte;
                    tFlip:Byte;
                    tRot: Integer;
                    tLine:Byte;
                    tCmmt:Byte;
                  End;

     TTxtCenter = Packed Record
                    yInt: Integer;
                    yFrac:Integer;
                    xInt: Integer;
                    xFrac:Integer;
                  End;

Var DisplayArea: Rect;
    LineHt:      Integer;
    LinePos:     Integer;
    fInfo:       FontInfo;

    PicComRec:   TTxtPicRec;
    PicComPtr:   QDPtr;
    PicComHdl:   QDHandle;

    TexRotRec:   TTxtCenter;
    TexRotPtr:   QDPtr;
    TexRotHdl:   QDHandle;

Begin
  InitDisplayArea(Where, DisplayArea);

{set the current font stuff}
  TextFont(CurntFontID);        {use the current font}
  TextFace(CurntStyleID);       {use the current style}
  TextSize(CurntSizeID);        {use the current size}

{setup the pic text comment record pointers, etc}
  PicComPtr :=  @PicComRec;
  PicComHdl :=  @PicComPtr;

  TexRotPtr :=  @TexRotRec;
  TexRotHdl :=  @TexRotPtr;

  PicComRec.tJus := 1;     {left justify}
  PicComRec.tFlip:= 0;     {none}
  PicComRec.tRot := 45;    {rotate 45 degrees CW}

  TexRotRec.yInt := 70;    {move down 60 pixels}
  TexRotRec.yFrac:= 0;     {make it 60.0}
  TexRotRec.xInt := 20;    {move across 20 pixels}
  TexRotRec.xFrac:= 0;     {make it 20.0}

  PicComment(TextBegin,  6, PicComHdl);
  PicComment(TextCenter, 8, TexRotHdl);

  MoveTo(10,30); DrawString('This text is rotated 45 degrees');

  PicComment(TextEnd, 0, NIL);

End;

{-----------------------------------------------------------------------------}

PROCEDURE PrintFineGrid (Where: Integer);
Var DisplayArea: Rect;
    Vinc, Hinc:  integer;
    pos:         integer;
    Boxes:       integer;
    count:       integer;
    FineLine:    rect;
Begin
  InitDisplayArea(Where, DisplayArea);

{divide the page into box's}
  Boxes := 16;
  Hinc := DisplayArea.right Div Boxes;
  Vinc := DisplayArea.bottom Div Boxes;

{do the vertical lines first}
  FineLine.top :=    DisplayArea.Top;
  FineLine.bottom := DisplayArea.Bottom;

  pos := DisplayArea.Left;         {start at the left}
  For count := 1 to boxes do
  begin
    FineLine.left:= pos;
    If where = theScreen
      then FineLine.right := pos + 1
      else FineLine.right := pos;
    FillRect(FineLine, black);
    pos := pos + Hinc;
  end;

{do the horizontal lines next}
  FineLine.left :=  DisplayArea.left;
  FineLine.right := DisplayArea.right;

  pos := DisplayArea.top;
  For count := 1 to boxes do
  begin
    FineLine.top:= pos;              {start at the top}
    If where = theScreen
      then FineLine.bottom := pos + 1
      else FineLine.bottom := pos;
    FillRect(FineLine, black);
    pos := pos + Vinc;
  end;

  FrameRect(DisplayArea);
End;

{-----------------------------------------------------------------------------}

PROCEDURE PrintPolygon  (Where: Integer);
Type TPolyVerb = Packed Record
                  f7,f6,f5,f4,f3,fPolyClose, fPolyFill, fPolyFrame:Boolean;
                 End;

Var DisplayArea:  Rect;
    PolyComRec:   TPolyVerb;
    PolyComPtr:   QDPtr;
    PolyComHdl:   QDHandle;
    PolyHdl:      PolyHandle;


Begin
  InitDisplayArea(Where, DisplayArea);

  If where = theLaserW then
    begin
    sysbeep(3);
      PolyComRec.fPolyClose := true;      {closed the polygon}
      PolyComRec.fPolyFrame := true;      {frame the polygon}
      PolyComRec.fPolyFill  := false;     {don't fill the polygon}
      PolyComPtr:= @PolyComRec;           {get the pointer set up}
      PolyComHdl:= @PolyComPtr;           {get the handle set up}

  {draw the rectangle}
      MoveTo(20,20);                      {set the initial position}
      PicComment(PolyBegin, 0, Nil);      {start the polygon, simple 80 X 80 square}
      PicComment(PolyVerb, 1,PolyComHdl); {send the frame & close command}
        LineTo(100,20);
        LineTo(100,100);
        LineTo(20,100);
        LineTo(20,20);
      PicComment(PolyEnd, 0, Nil);        {end the polygon}

  {draw the triangle}
      MoveTo(150,200);
      PolyComRec.fPolyFill  := true;      {fill the polygon}
      PicComment(PolyBegin, 0, Nil);      {start the polygon, simple 80 X 80 square}
      PicComment(PolyVerb, 1,PolyComHdl); {send the fill, frame & close command}
        LineTo(200,250);
        LineTo(100,250);
        LineTo(150,200);
      PicComment(PolyEnd, 0, Nil);        {end the polygon}
    end


  else  {use the regular stuff and show it on the screen}
    begin
      PolyHdl := OpenPoly;
        MoveTo(20,20);
        LineTo(100,20);
        LineTo(100,100);
        LineTo(20,100);
        LineTo(20,20);
      ClosePoly;
      FramePoly(PolyHdl);
      KillPoly(PolyHdl);

      PolyHdl := OpenPoly;
        MoveTo(150,200);
        LineTo(200,250);
        LineTo(100,250);
        LineTo(150,200);
      ClosePoly;
      FillPoly(PolyHdl, LtGray);
      FramePoly(polyHdl);
      KillPoly(PolyHdl);
    end;
End;

{-----------------------------------------------------------------------------}


PROCEDURE BuildQDPicture(where:integer);
Var
    OriginalRect: Rect;
    SaveClip:     RgnHandle;

Begin
  SetRect(OriginalRect,0,0,719,363);       {this rect holds the initial Pic}
  SaveClip := NewRgn;                      {get a Rgn to store the clip}
  GetClip(SaveClip);                       {save the current clip region}
  ClipRect(OriginalRect);                  {set the clip to the drawing area}

  QDPicture := OpenPicture(OriginalRect);  {start the picture}
  Pensize(3,3);
  FrameRect(OriginalRect);                 {frame it}
  PenSize(1,1);
  MakeQDCalls(where);                      {draw the QD calls}
  ClosePicture;                            {close it}

  SetClip(SaveClip);                       {reset the clip }
  DisposeRgn(SaveClip);                    {get rid of new clip}
End;

{-----------------------------------------------------------------------------}

PROCEDURE ShowQDPic(Where:integer);
Var DisplayArea: Rect;
Begin
  If where = theScreen
  then begin
    InitDisplayArea(Where, DisplayArea);
    BuildQDPicture(where);                 {knock out some things if goint to Laser}
    DrawPicture(QDPicture, DisplayArea);
  end

  else {build the picture some where else}
   DrawPicture(QDPicture, DefaltPage);

  KillPicture(QDPicture);
End;

{-----------------------------------------------------------------------------}

PROCEDURE ShowAllQDCalls(Where:integer);
Var DisplayArea: Rect;
Begin
  InitDisplayArea(Where, DisplayArea);
  MakeQDCalls(Where);
End;

{-----------------------------------------------------------------------------}

PROCEDURE DrawIcon(whichIcon,h,v: integer);
{This procedure draws an icon at location h, v}
Var
    srcBits           : BitMap;
    srcRect, dstRect  : Rect;

Begin
  srcBits.baseAddr:=@icons[whichIcon];   {set start address for icon data}
  srcBits.rowBytes:=6;                   {set 6 as # of bytes per row}
  SetRect(srcBits.bounds,0,0,48,32);     {48 X 32 pixels = 6 X 4 bytes}
  srcRect:=srcBits.bounds;               {set the source bounding rect}
  dstRect:=srcRect;                      {make the destination rect the same}
  OffsetRect(dstRect,h,v);               {offset from other icons}

  CopyBits(srcBits,thePort^.portBits,srcRect,dstRect,srcOr,Nil);
End;

{-----------------------------------------------------------------------------}

PROCEDURE MakeQDCalls(where:integer);
VAR i: INTEGER;
    tempRect,
    OriginalRect : Rect;
    myPoly       : PolyHandle;
    myRgn        : RgnHandle;
    myPattern    : Pattern;

BEGIN

  {SetRect(OriginalRect,0,0,719,363);  this rect holds the initial Pic}

  { draw two horizontal lines across the top }
  MoveTo(0,18);
  LineTo(719,18);
  MoveTo(0,20);
  LineTo(719,20);

  { draw divider lines }
  MoveTo(0,134);
  LineTo(719,134);
  MoveTo(0,248);
  LineTo(719,248);
  MoveTo(240,21);
  LineTo(240,363);
  MoveTo(480,21);
  LineTo(480,363);

{set the current font stuff}
  TextFont(CurntFontID);        {use the current font}
  TextFace(CurntStyleID);       {use the current style}
  TextSize(CurntSizeID);        {use the current size}

{draw title}
  MoveTo(210,14);
  DrawString('Look what you can draw with QuickDraw');


  {---------  draw text samples --------- }

  MoveTo(80,34);  DrawString('Text');

  TextFace([bold]);
  MoveTo(70,55);  DrawString('Bold');

  TextFace([italic]);
  MoveTo(70,70); DrawString('Italic');

  TextFace([underline]);
  MoveTo(70,85); DrawString('Underline');

  TextFace([outline]);
  MoveTo(70,100); DrawString('Outline');

  TextFace([shadow]);
  MoveTo(70,115); DrawString('Shadow');

  TextFace([]);   { restore to normal }


  { --------- draw line samples --------- }

  MoveTo(330,34);  DrawString('Lines');

  MoveTo(280,25);  Line(160,40);

  PenSize(3,2);
  MoveTo(280,35);  Line(160,40);

  PenSize(6,4);
  MoveTo(280,46);  Line(160,40);

  PenSize(12,8);
  PenPat(gray);
  MoveTo(280,61); Line(160,40);

  PenSize(15,10);
  StuffHex(@myPattern,'8040200002040800'); {create a new pattern}
  PenPat(myPattern);                       {set as the new pen pattern}
  MoveTo(280,80); Line(160,40);
  PenNormal;

  { --------- draw rectangle samples --------- }

  MoveTo(560,34);  DrawString('Rectangles');

  SetRect(tempRect,510,40,570,70);
  FrameRect(tempRect);

  OffsetRect(tempRect,25,15);
  PenSize(3,2);
  EraseRect(tempRect); {this is so the top rect will not show thru the next one}
  FrameRect(tempRect);

  OffsetRect(tempRect,25,15);
  PaintRect(tempRect);   {this rect is painted so we do not have to erase area}

  OffsetRect(tempRect,25,15);
  PenNormal;
  FillRect(tempRect,gray);
  FrameRect(tempRect);

  OffsetRect(tempRect,25,15);
  FillRect(tempRect,myPattern);
  FrameRect(tempRect);

  { --------- draw roundRect samples --------- }

  MoveTo(70,148);  DrawString('RoundRects');

  SetRect(tempRect,30,150,90,180);
  FrameRoundRect(tempRect,30,20);

  OffsetRect(tempRect,25,15);
  PenSize(3,2);
  EraseRoundRect(tempRect,30,20);
  FrameRoundRect(tempRect,30,20);

  OffsetRect(tempRect,25,15);
  PaintRoundRect(tempRect,30,20);

  OffsetRect(tempRect,25,15);
  PenNormal;
  FillRoundRect(tempRect,30,20,gray);
  FrameRoundRect(tempRect,30,20);

  OffsetRect(tempRect,25,15);
  FillRoundRect(tempRect,30,20,myPattern);
  FrameRoundRect(tempRect,30,20);

  { --------- draw bitmap samples --------- }

  MoveTo(320,148);  DrawString('BitMaps');

  DrawIcon(0,266,156);
  DrawIcon(1,336,156);
  DrawIcon(2,406,156);
  DrawIcon(3,266,196);
  DrawIcon(4,336,196);
  DrawIcon(5,406,196);

  { --------- draw ARC samples --------- }

  MoveTo(570,148);  DrawString('Arcs');

  SetRect(tempRect,520,153,655,243);
  FillArc(tempRect,135,65,dkGray);
  FillArc(tempRect,200,130,myPattern);
  FillArc(tempRect,330,75,gray);
  FrameArc(tempRect,135,270);
  OffsetRect(tempRect,20,0);
  PaintArc(tempRect,45,90);

  { --------- draw polygon samples --------- }

  MoveTo(80,262);  DrawString('Polygons');

  myPoly:=OpenPoly;     {capture QD calls that make up the polygon}
    MoveTo(30,290);
    LineTo(30,280);
    LineTo(50,265);
    LineTo(90,265);
    LineTo(80,280);
    LineTo(95,290);
    LineTo(30,290);
  ClosePoly;           { end of definition of the polygon}

  FramePoly(myPoly);   {now use it just like you would a rectangle or etc.}

  OffsetPoly(myPoly,25,15);
  PenSize(3,2);
  ErasePoly(myPoly);
  FramePoly(myPoly);

  OffsetPoly(myPoly,25,15);
  PaintPoly(myPoly);

  OffsetPoly(myPoly,25,15);
  PenNormal;
  FillPoly(myPoly,gray);
  FramePoly(myPoly);

  OffsetPoly(myPoly,25,15);
  FillPoly(myPoly,myPattern);
  FramePoly(myPoly);

  KillPoly(myPoly);

  { --------- demonstrate regions --------- }

  MoveTo(320,262);  DrawString('Regions');

  If where <> theLaserW
  then
    begin

      myRgn:=NewRgn;       {allocate space of a new region}
      OpenRgn;             {start saving region defintion calls}

        ShowPen;  {OpenRgn calls HidePen so if drawing to screen call ShowPen }
                  {if creating a picture delete this call}

        SetRect(tempRect,260,270,460,350);
        FrameRoundRect(tempRect,24,16);    {rounded corner rectangle}

        MoveTo(275,335);  { define triangular hole }
        LineTo(325,285);
        LineTo(375,335);
        LineTo(275,335);

        SetRect(tempRect,365,277,445,325);   { oval hole }
        FrameOval(tempRect);

        HidePen;   {this call would balance the ShowPen call set above}
      CloseRgn(myRgn);       { end of definition of the region}
      PaintRgn(myRgn);       {show the region with black pattern}
      DisposeRgn(myRgn);     {dont need it any more so throw it away}
    end

  else
    begin
      MoveTo(270,300);  DrawString('Dont use regions');
      Moveto(275,320);  DrawString('on LaserPrinter');
    end;

  { --------- draw oval samples --------- }

  MoveTo(580,262);  DrawString('Ovals');

  SetRect(tempRect,510,264,570,294);
  FrameOval(tempRect);

  OffsetRect(tempRect,25,15);
  PenSize(3,2);
  EraseOval(tempRect);
  FrameOval(tempRect);

  OffsetRect(tempRect,25,15);
  PaintOval(tempRect);

  OffsetRect(tempRect,25,15);
  PenNormal;
  FillOval(tempRect,gray);
  FrameOval(tempRect);

  OffsetRect(tempRect,25,15);
  FillOval(tempRect,myPattern);
  FrameOval(tempRect);

END; {QDCalls}

{-----------------------------------------------------------------------------}

PROCEDURE ChkOnOffItem(MenuHdl:MenuHandle; item, fst, lst:Integer);
Var i: integer;
Begin
  For i := fst to lst do
    If item = i
    then CheckItem(MenuHdl, i, TRUE)       {check it on in menu}
    else CheckItem(MenuHdl, i, FALSE);     {check it off in menu}
End;

{-----------------------------------------------------------------------------}

PROCEDURE ProcessMenu_in(CodeWord:longint; fromMenu:Boolean);
Var
  Menu_No,                    {menu number that was selected}
  Item_No:    integer;        {item in menu that was selected}
  NameHolder: Str255;         {name holder for desk accessory or font}
  MenuHdl:    MenuHandle;     {handle to the menu}
  dummy:      boolean;
  LDummy:     LongInt;
  PrChooser:  LMwordPtr;      {used to disable/enable the chooser}

Begin
  If CodeWord <> 0 then {go ahead and process the command}
  begin
    Menu_No := HiWord(CodeWord);
    Item_No := LoWord(CodeWord);

    Case Menu_No of

     AppleMenu: begin
                  GetItem(GetMenu(AppleMenu), Item_No, NameHolder);
                  If OpenDeskAcc(NameHolder) = 0
                  then begin {put up a dialog saying it cannot open it} end;
                end;

    PrDlogMenu: begin
                   Case Item_No of
                     1: begin
                          dummy := PrStlDialog(PrRecordHdl);
                        end;
                     2: begin
                          If PrJobDialog(PrRecordHdl)
                          then PrintIt(CurPrTest);
                        end;

                    {3: line divider}

                     4: begin
                          PrChooser := LMwordPtr($946);       {set the address}
                          GetStuff(PrChooser^).f15 := FALSE;  {set bit7 of $946}
                        end;
                     5: begin
                          PrChooser := LMwordPtr($946);       {set the address}
                          GetStuff(PrChooser^).f15 := TRUE;   {set bit7 of $946}
                        end;

                    {6: line divider}

                     7:Finished := true;      {terminate the program}
                   End;
                 end;

      PrintMenu: Begin
                  MenuHdl := GetMenu(PrintMenu);    {menu handle for PrTests}
                  Case Item_No of
                   1: begin
                        CurPrTest := PrFramePage;
                        ChkOnOffItem(MenuHdl, 1, 1, 11);
                        FramePage(theScreen);
                      end;

                   2: begin
                        CurPrTest := PrFrameText;
                        ChkOnOffItem(MenuHdl, 2, 1, 11);
                        FrameText(theScreen);
                      end;

                   3: begin
                        CurPrTest := PrMakeQDCalls;
                        ChkOnOffItem(MenuHdl, 3, 1, 11);
                        ShowAllQDCalls(theScreen);
                      end;

                   4: begin
                        CurPrTest := PrDrawPicture;
                        ChkOnOffItem(MenuHdl, 4, 1, 11);
                        ShowQDPic(theScreen);
                      end;

                   5: begin
                        CurPrTest := PrUseTextBox;
                        ChkOnOffItem(MenuHdl, 5, 1, 11);
                        UseTextBox(theScreen);
                      end;

                   6: begin
                        CurPrTest := PrBitMap;
                        ChkOnOffItem(MenuHdl, 6, 1, 11);
                        PrintBitMap(theScreen);
                      end;

                   7: begin
                        CurPrTest := PrChkSetOrig;
                        ChkOnOffItem(MenuHdl, 7, 1, 11);
                        PrintLables(theScreen);
                      end;

                   8: begin
                        CurPrTest := PrChkPicComm;
                        ChkOnOffItem(MenuHdl, 8, 1, 11);
                        PrintText(theScreen);
                      end;

                   9: begin
                        CurPrTest := PrRotateTex;
                        ChkOnOffItem(MenuHdl, 9, 1, 11);
                        PrintRotText(theScreen);
                      end;


                  10: begin
                        CurPrTest := PrFineGrid;
                        ChkOnOffItem(MenuHdl, 10, 1, 11);
                        PrintFineGrid(theScreen);
                      end;

                  11: begin
                        CurPrTest := PrSmothPloy;
                        ChkOnOffItem(MenuHdl, 11, 1, 11);
                        PrintPolygon(theScreen);
                      end;

                   End;
                 End;

       FontMenu: begin
                   MenuHdl := GetMenu(FontMenu);             {menu handle for fonts}
                   CheckItem(MenuHdl, PrevFontChked, False); {uncheck the prev.one}
                   GetItem(MenuHdl, Item_No, NameHolder);    {get new font name}
                   PrevFontChked := Item_No;                 {save the new font No}
                   GetFNum(NameHolder, CurntFontID);         {get the font ID}
                   CheckItem(MenuHdl, Item_No, True);        {check it off in menu}
                 end;

      StyleMenu: begin
                   MenuHdl := GetMenu(StyleMenu);          {menu handle for style}
                   Case Item_No of
                     1:begin
                         CurntStyleID := [];      {plain}
                         ChkOnOffItem(MenuHdl, 1, 1, 6);
                       end;
                     2:begin
                         CurntStyleID := CurntStyleID + [Bold];
                         CheckItem(MenuHdl, 2, True);      {check it off in menu}
                         CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
                       end;
                     3:begin
                         CurntStyleID := CurntStyleID + [Italic];
                         CheckItem(MenuHdl, 3, True);     {check it off in menu}
                         CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
                       end;
                     4:begin
                         CurntStyleID := CurntStyleID + [underline];
                         CheckItem(MenuHdl, 4, True);     {check it off in menu}
                         CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
                       end;
                     5:begin
                         CurntStyleID := CurntStyleID + [outline];
                         CheckItem(MenuHdl, 5, True);     {check it off in menu}
                         CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
                       end;
                     6:begin
                         CurntStyleID := CurntStyleID + [shadow];
                         CheckItem(MenuHdl, 6, True);      {check it off in menu}
                         CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
                       end;

                    {7: line divider}

                     8:begin  {9 point}
                         CurntSizeID := 9;
                         ChkOnOffItem(MenuHdl, 8, 8, 13);
                       end;
                     9:begin  {10 point}
                         CurntSizeID := 10;
                         ChkOnOffItem(MenuHdl, 9, 8, 13);
                       end;
                    10:begin  {12 point}
                         CurntSizeID := 12;
                         ChkOnOffItem(MenuHdl, 10, 8, 13);
                       end;
                    11:begin  {14 point}
                         CurntSizeID := 14;
                         ChkOnOffItem(MenuHdl, 11, 8, 13);
                       end;
                    12:begin  {18 point}
                         CurntSizeID := 18;
                         ChkOnOffItem(MenuHdl, 12, 8, 13);
                       end;
                    13:begin  {24 point}
                         CurntSizeID := 24;
                         ChkOnOffItem(MenuHdl, 13, 8, 13);
                       end;

                   End;
                 end;

      PrDrvrMenu:begin
                   Case Item_No of
                     1: PrDrBitMap;
                     2: PrDrScr_wEvtCtl;
                     3: PrDrScrBitMap;
                     4: PrDrStreamText;
                     5: PrDrPostScript;
                   End;
                 end;

      PicScrMenu:begin
                   If Item_No = 1 then PutPicScrap;
                 end;

    End;{case of Menu_No}

    HiliteMenu(0);               {unhilite after processing menu}
  end; {the If codeword <> 0}
End; {of ProcessMenu_in procedure}

{-----------------------------------------------------------------------------}

PROCEDURE DealwthMouseDowns(Event:EventRecord);
Var Location: integer;
    WindowPointedTo: WindowPtr;
    MouseLoc:Point;
    WindoLoc:integer;
Begin
  MouseLoc := Event.Where;
  WindoLoc := FindWindow(MouseLoc, WindowPointedTo);
  Case WindoLoc of

     inMenuBar: ProcessMenu_in(MenuSelect(MouseLoc), True);

     inSysWindow: SystemClick(Event,WindowPointedTo);

     inContent: begin end;
              (*If WindowPointedTo <> FrontWindow
                then SelectWindow(WindowPointedTo)
                else begin {do something} end;*)

     inGrow   : begin end;
              (*If WindowPointedTo <> FrontWindow
                then SelectWindow(WindowPointedTo)
                else ReSizeWindow(WindowPointedTo,MouseLoc,GrowArea);*)

     inDrag   :DragWindow(WindowPointedTo,MouseLoc,DragArea);

     inGoAway :If TrackGoAway(WindowPointedTo,MouseLoc)
               then
                 begin
                   CloseWindow(WindowPointedTo);
                   Finished := true;
                 end;

  End{ of case};
End;

{-----------------------------------------------------------------------------}

PROCEDURE DealwthKeyDowns(Event:EventRecord);
Var Character:char;
Begin
   Character:= CHR(Event.message MOD 256);

  If BitTst(@Event.modifier,Bit7)
   then
     begin  {key board command}
       ProcessMenu_in(MenuKey(Character), False);
     end
   else
     begin  {regular keyboard entry}
       {TEKey(Character,TextHandle);}
       {Scrolltext}
     end;
End;

{-----------------------------------------------------------------------------}

PROCEDURE DealwthActivates(Event: EventRecord);
Var EventMsgWindow:WindowPtr;
Begin
   EventMsgWindow := WindowPtr(Event.message);
   {DrawGrowIcon(EventMsgWindow);}

   If Odd(Event.modifiers) {then the window is becoming active}
   then
     begin
       SetPort(EventMsgWindow);
       {and activate whatever else you need}
     end
   else
     begin
       {deactivate whatever you need}
     end;
End;

{-----------------------------------------------------------------------------}

PROCEDURE DealwthUpdates(Event:EventRecord);
Var EventMsgWindow,
          TempPort: WindowPtr;
Begin
   EventMsgWindow := WindowPtr(Event.message);
   GetPort(TempPort);                {Save the current port}

   SetPort    (EventMsgWindow);      {set the port to one in Evt.msg}
   BeginUpDate(EventMsgWindow);
     EraseRect(EventMsgWindow^.portRect);
    { WhichPrinter;                              Proc to ID the printer}
     {DrawGrowIcon(EventMsgWindow);}
   EndUpDate  (EventMsgWindow);
   SetPort    (TempPort);             {restore to the previous port}
End;

{-----------------------------------------------------------------------------}

PROCEDURE MainEventLoop;
Var Event:EventRecord;
    ProcessIt: Boolean;
Begin
  Repeat
    SystemTask;             {so you can support Desk Accessories}

    ProcessIt := GetNextEvent(EveryEvent,Event);
    If ProcessIt{is true} then {we'll ProcessIt}
          Case Event.what of

            mouseDown  : DealwthMouseDowns(Event);
            KeyDown    : DealwthKeyDowns  (Event);
            ActivateEvt: DealwthActivates (Event);
            UpDateEvt  : DealwthUpdates   (Event);

          End;{of Case}
  Until Finished; {terminate the program}
End;

{-----------------------------------------------------------------------------}

PROCEDURE InitIcons;
{ Manually stuff some icons.  Normally we would read them from a file }
BEGIN
{each line contains 48 HEX #s which fill 12 consecutive words up to 96}

  { Lisa }
  StuffHex(@icons[0, 0],'000000000000000000000000000000000000001FFFFFFFFC');
  StuffHex(@icons[0,12],'00600000000601800000000B0600000000130FFFFFFFFFA3');
  StuffHex(@icons[0,24],'18000000004311FFFFF00023120000080F231200000BF923');
  StuffHex(@icons[0,36],'120000080F23120000080023120000080023120000080F23');
  StuffHex(@icons[0,48],'1200000BF923120000080F2312000008002311FFFFF00023');
  StuffHex(@icons[0,60],'08000000004307FFFFFFFFA30100000000260FFFFFFFFE2C');
  StuffHex(@icons[0,72],'18000000013832AAAAA8A9F0655555515380C2AAAA82A580');
  StuffHex(@icons[0,84],'800000000980FFFFFFFFF300800000001600FFFFFFFFFC00');

  { Printer }
  StuffHex(@icons[1, 0],'000000000000000000000000000000000000000000000000');
  StuffHex(@icons[1,12],'00000000000000007FFFFF00000080000280000111514440');
  StuffHex(@icons[1,24],'0002000008400004454510400004000017C00004A5151000');
  StuffHex(@icons[1,36],'0004000010000004A54510000004000017FE00F4A5151003');
  StuffHex(@icons[1,48],'0184000013870327FFFFF10F06400000021B0CFFFFFFFC37');
  StuffHex(@icons[1,60],'18000000006B3000000000D77FFFFFFFFFABC00000000356');
  StuffHex(@icons[1,72],'8000000001AC87F000000158841000CCC1B087F000CCC160');
  StuffHex(@icons[1,84],'8000000001C0C000000003807FFFFFFFFF0007800001E000');

  { Trash Can }
  StuffHex(@icons[2, 0],'000001FC000000000E0600000000300300000000C0918000');
  StuffHex(@icons[2,12],'00013849800000026C4980000004C0930000000861260000');
  StuffHex(@icons[2,24],'0010064FE0000031199830000020E6301800002418E00800');
  StuffHex(@icons[2,36],'0033E3801C0000180E002C00000FF801CC0000047FFE0C00');
  StuffHex(@icons[2,48],'000500004C000005259A4C000005250A4C00000525FA4C00');
  StuffHex(@icons[2,60],'000524024C00000524924C00600524924C0090E524924C7C');
  StuffHex(@icons[2,72],'932524924C82A44524924D01C88524924CF10C4524924C09');
  StuffHex(@icons[2,84],'0784249258E70003049233100000E000E40800001FFFC3F0');

  { tray }
  StuffHex(@icons[3, 0],'000000000000000000000000000000000000000000000000');
  StuffHex(@icons[3,12],'0000000000000000000000000000000000000007FFFFFFF0');
  StuffHex(@icons[3,24],'000E00000018001A00000038003600000078006A000000D8');
  StuffHex(@icons[3,36],'00D7FFFFFFB801AC000003580358000006B807FC000FFD58');
  StuffHex(@icons[3,48],'040600180AB80403FFF00D58040000000AB8040000000D58');
  StuffHex(@icons[3,60],'040000000AB807FFFFFFFD5806AC00000AB8055800000D58');
  StuffHex(@icons[3,72],'06B000000AB807FC000FFD70040600180AE00403FFF00DC0');
  StuffHex(@icons[3,84],'040000000B80040000000F00040000000E0007FFFFFFFC00');

  { File Cabinet }
  StuffHex(@icons[4, 0],'0007FFFFFC00000800000C00001000001C00002000003400');
  StuffHex(@icons[4,12],'004000006C0000FFFFFFD40000800000AC0000BFFFFED400');
  StuffHex(@icons[4,24],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
  StuffHex(@icons[4,36],'00A00002AC0000A08082D40000A0FF82AC0000A00002D400');
  StuffHex(@icons[4,48],'00A00002AC0000BFFFFED40000800000AC0000BFFFFED400');
  StuffHex(@icons[4,60],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
  StuffHex(@icons[4,72],'00A00002AC0000A08082D40000A0FF82AC0000A00002D800');
  StuffHex(@icons[4,84],'00A00002B00000BFFFFEE00000800000C00000FFFFFF8000');

  { drawer }
  StuffHex(@icons[5, 0],'000000000000000000000000000000000000000000000000');
  StuffHex(@icons[5,12],'000000000000000000000000000000000000000000000000');
  StuffHex(@icons[5,24],'000000000000000000000000000000000000000000000000');
  StuffHex(@icons[5,36],'00000000000000000000000000000000000000001FFFFFF0');
  StuffHex(@icons[5,48],'0000380000300000680000700000D80000D0003FFFFFF1B0');
  StuffHex(@icons[5,60],'0020000013500020000016B000201FE01D50002010201AB0');
  StuffHex(@icons[5,72],'00201FE01560002000001AC0002000001580002020101B00');
  StuffHex(@icons[5,84],'00203FF01600002000001C00002000001800003FFFFFF000');

END;

{-----------------------------------------------------------------------------}

PROCEDURE PutPicScrap;
Var err:     LongInt;
    PicRect: Rect;
    PicHdl:  PicHandle;
    PicLen:  LongInt;
Begin
  PicRect := DefaltPage;
  PicRect.bottom := PicRect.bottom Div 2;
  PicRect.right := PicRect.right Div 2;

  BuildQDPicture(theScreen);

  PicHdl := OpenPicture(PicRect);
  DrawPicture(QDPicture, PicRect);
  ClosePicture;
  PicLen := PicHdl^^.PicSize;

  HLock(Handle(PicHdl));
  err := ZeroScrap;
  err := PutScrap(PicLen, 'PICT', Pointer(PicHdl^));
  HUnLock(Handle(PicHdl));
  KillPicture(QDPicture);
  KillPicture(PicHdl);
End;

{-----------------------------------------------------------------------------}

PROCEDURE InitThings;
Begin
  InitGraf(@thePort);          {create a grafport for the screen}

  MoreMasters;                 {extra pointer blocks at the bottom of the heap}
  MoreMasters;                 {this is 5 X 64 master pointers}
  MoreMasters;
  MoreMasters;
  MoreMasters;

{get the cursors we use and lock them down - no clutter}
  ClockCursor := GetCursor(watchCursor);
  HLock(Handle(ClockCursor));

{show the watch while we wait for inits & setups to finish}
  SetCursor(ClockCursor^^);

{init everything in case the app is the Startup App}
  InitFonts;                     {startup the fonts manager}
  InitWindows;                   {startup the window manager}
  InitMenus;                     {startup the menu manager}
  TEInit;                        {startup the text edit manager}
  InitDialogs(Nil);              {startup the dialog manager}

{set some global stuff}
  Finished := False;             {set program terminator to false}
  FlushEvents(everyEvent,0);     {clear events from previous program}
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetupLimits;
Begin
  Screen := ScreenBits.Bounds;   {set the size of the screen}
  SetRect(DragArea,Screen.left+4,Screen.top+24,Screen.right-4,Screen.bottom-4);
  SetRect(GrowArea,Screen.left,Screen.top+24,Screen.right,Screen.bottom);
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetupMenus;
Var  MenuTopic:   MenuHandle;
     NameHolder:  STR255;
     FoundIt:     Boolean;
     Item_No:     Integer;
     NumItems:    Integer;
     FontID:      Integer;
     useThisFont: Integer;

Begin
  MenuTopic := GetMenu(AppleMenu);  {get the apple desk accessories menu}
  AddResMenu(MenuTopic,'DRVR');     {adds all names into item list}
  InsertMenu(MenuTopic,0);          {put in list held by menu manager}

  MenuTopic := GetMenu(PrDlogMenu);
  InsertMenu(MenuTopic,0);

  MenuTopic := GetMenu(PrintMenu);
  InsertMenu(MenuTopic,0);

  MenuTopic := GetMenu(PrDrvrMenu);
  InsertMenu(MenuTopic,0);

  MenuTopic := GetMenu(FontMenu);
  AddResMenu(MenuTopic,'FONT');
  InsertMenu(MenuTopic,0);

  MenuTopic := GetMenu(StyleMenu);
  InsertMenu(MenuTopic,0);

  MenuTopic := GetMenu(PicScrMenu);
  InsertMenu(MenuTopic,0);

{check off the default font. If LaserWriter set to Helvetica}
  If theLaserW = GetStuff(PrRecordHdl^^.PrStl.wDev).b1
    then useThisFont := 20 {helvetica}
    else useThisFont := Geneva;

  MenuTopic := GetMenu(FontMenu);             {menu handle for fonts}
  NumItems := CountMItems(MenuTopic);         {number of fonts in menu}
  FoundIt := False;
  Item_No := 1;
  Repeat
    GetItem(MenuTopic, Item_No, NameHolder);    {get new font name}
    GetFNum(NameHolder, FontID);              {get the font ID}
    If FontID = useThisFont then              {is it same as default font??}
    begin
      PrevFontChked := Item_No;                 {save the new font No}
      CheckItem(MenuTopic, Item_No, True);        {check it off in menu}
      FoundIt := true;
    end;
    Item_No := Item_No + 1;
  Until (Item_No > NumItems) or FoundIt;

{check off the font style}
  MenuTopic := GetMenu(StyleMenu);             {menu handle for style}
  CheckItem(MenuTopic, 1, True);               {check the plain style}

{check off the size}
  CheckItem(MenuTopic, 10, True);              {check the 12 point}

{set the global guys}
  CurntFontID := FontID;   {the default font}
  CurntStyleID := [];      {plain}
  CurntSizeID := 12;       {size 12}

{because we didn't finish the code.... disable some menu items}
  MenuTopic := GetMHandle(PrDrvrMenu);
  DisableItem(MenuTopic, 5);      {write postscript sample}

  MenuTopic := GetMHandle(PrintMenu);
  DisableItem(MenuTopic, 11);     {trick polygon}

{now draw the menu bar}
  DrawMenuBar;           {all done so show the menu bar}
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetupAWindow;
Begin
  aWindow := GetNewWindow(WindResID, Nil, Pointer(-1));
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetupPrPort;
Var dummy: boolean;
Begin
  PrRecordHdl := THPrint(NewHandle(SizeOf(TPrint)));   {Make space for the record}
  PrOpen;                                              {open up ptr resource file}
  PrintDefault(PrRecordHdl);                           {fill rec w/default params}
  DefaltPage := PrRecordHdl^^.prInfoPT.rPage;          {default printer page size}
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetUpThings;
Begin
  SetupLimits;
  SetupAWindow;
  SetupPrPort;
  SetupMenus;           {this order is important for checking items off}

  InitCursor;           {ready to go, so show the Arrow cursor}
End;

{-----------------------------------------------------------------------------}

PROCEDURE CloseThings;
Var PrChooser: LMwordPtr;
Begin
{make sure the Chooser is enabled upon leaving the App}
  PrChooser := LMwordPtr($946);       {set the address}
  GetStuff(PrChooser^).f15 := TRUE;   {set bit7 of $946}
  PrClose;
End;

{-----------------------------------------------------------------------------}

BEGIN
  InitThings;
  SetUpThings;
  MainEventLoop;
  CloseThings;
END.
